home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #324 (1994-04)(Rhein-Sieg-Soft).zip / Franz PD Disk #324 (1994-04)(Rhein-Sieg-Soft).adf / VideoText3.5 / source / bildschirm.p next >
Text File  |  1994-04-01  |  12KB  |  377 lines
  1. UNIT bildschirm; {$project vt }
  2. { Bildschirmausgaben zum Programm VideoText }
  3.  
  4. INTERFACE; FROM vt USES global,sys,decode,cct;
  5.  
  6. PROCEDURE cursoroff;
  7. PROCEDURE cursoron;
  8. PROCEDURE mainline;
  9. PROCEDURE mark_queue(alt: Integer);
  10. PROCEDURE redraw_queue(job: Integer);
  11. PROCEDURE redraw_list;
  12. PROCEDURE mark_list(reallydraw: Boolean);
  13. PROCEDURE fileinfo;
  14. PROCEDURE test(active: Boolean);
  15. PROCEDURE displayhelp;
  16. PROCEDURE scanpages;
  17. PROCEDURE writepage(seite: p_onepage, verdeckt: Boolean);
  18. PROCEDURE redraw_all;
  19.  
  20. { ---------------------------------------------------------------------- }
  21.  
  22. IMPLEMENTATION;
  23. {$opt b-}
  24.  
  25. VAR listoffset: Integer;
  26.  
  27. PROCEDURE cursoroff;
  28. begin
  29.   write(#155'0 p');  { Cursor unsichtbar }
  30. end;
  31.  
  32. PROCEDURE cursoron;
  33. begin
  34.   write(#155' p');  { Cursor wieder sichtbar }
  35. end;
  36.  
  37. PROCEDURE mainline;
  38. begin
  39.   gotoxy(1,24); write(#155'37m',copy(blank40,1,39));
  40.   gotoxy(1,24);
  41. end;
  42.  
  43. PROCEDURE mark_queue{(alt: Integer)};
  44. { Gibt die Position des Job-Markers <thisjob> am Bildschirm aus, ein alter }
  45. { Marker auf Position <alt> wird zuvor gelöscht. }
  46. const x0=1; y0=2;
  47. begin
  48.   IF alt<0 THEN GotoXY(x0,y0+1+maxactive-alt)
  49.     ELSE GotoXY(x0,y0-1+maxactive-alt);
  50.   Write(' ');
  51.   IF thisjob<0 THEN GotoXY(x0,y0+1+maxactive-thisjob)
  52.     ELSE GotoXY(x0,y0-1+maxactive-thisjob);
  53.   Write(#155'37m>');
  54. end;
  55.  
  56. PROCEDURE redraw_queue{(job: Integer)};
  57. { Gibt für job<0 die aktuelle Belegung der Warteschlange und der aktiven Jobs }
  58. { am Bildschirm aus, sonst wird nur der Job mit der angegebenen Nummer neu }
  59. { ausgegeben: interessant ist dabei vor allem der Status der eingelesenen }
  60. { Unterseiten. }
  61. CONST x0=1; y0=1;
  62. VAR i,j,max: Integer;
  63. BEGIN
  64.   GotoXY(x0,y0); Write(#155'37m Seitensuche:');
  65.   FOR j := 0 TO maxactive-1 DO
  66.     IF (job<0) OR (j=job) THEN WITH activejobs[j] DO BEGIN
  67.       GotoXY(x0,maxactive+y0-j); write(copy(blank40,1,anzsubpage+10));
  68.       GotoXY(x0+1,maxactive+y0-j);
  69.       IF pg=0 THEN Write('---')
  70.       ELSE BEGIN
  71.         Write(pg); IF sp>0 THEN Write('/',sp);
  72.         IF ist_UT>3 THEN
  73.           Write(' UT ')
  74.         ELSE IF ist_UT>0 THEN
  75.           Write(' UT? ')
  76.         ELSE
  77.           write('  ');
  78.         IF sp_check[0] THEN Write('*');
  79.         IF sp_max>0 THEN     { echte Unterseiten eingetroffen }
  80.           IF sp>0 THEN       { zu einer Einzelanforderung? }
  81.             Write('*')
  82.           ELSE BEGIN
  83.             max := sp_max; if max>anzsubpage then max := anzsubpage;
  84.             write('(');
  85.             for i := 1 to max do
  86.               if sp_check[i] then write('*') else write('-');
  87.             if sp_max>max then write('...') else write(')');
  88.           END;
  89.       END;
  90.     END;
  91.   GotoXY(x0,y0+2+maxactive); Write(' Jobs:');
  92.   IF job<0 THEN BEGIN
  93.     for j := 1 to qlen do begin
  94.       gotoxy(x0,j+y0+2+maxactive); write('         ');
  95.       if j<=queued then begin
  96.         gotoxy(x0+1,j+y0+2+maxactive);
  97.         write(queue[j].pg);
  98.         if queue[j].sp>0 then write('/',queue[j].sp);
  99.       end;
  100.     end;
  101.   END;
  102.   mark_queue(0);
  103. end;
  104.  
  105. PROCEDURE redraw_list;
  106. { Gibt eine Übersicht über die in der verketteten Liste gespeicherten }
  107. { VT-Seiten aus. Es werden drei Spalten zu <qlen> Zeilen erzeugt. Da die }
  108. { Liste nicht unbedingt ganz auf den Bildschirm paßt, wird ggf. ein Offset }
  109. { berücksichtigt. }
  110. const x0=10; y0=3+maxactive;
  111.       h=qlen; b=9; cols=3;
  112. var i,j: integer;
  113.     hilf: p_onepage;
  114. begin
  115.   { <listoffset> Seiten überschlagen: }
  116.   hilf := root;
  117.   for i := 1 to listoffset do
  118.     if hilf<>Nil then hilf := hilf^.next;
  119.   { Ausgabe erzeugen: }
  120.   gotoxy(x0,y0); write(#155,'37m Im Speicher:');
  121.   for i := 0 to cols-1 do
  122.     for j := 1 to h do begin
  123.       gotoxy(x0+b*i,j+y0); write('         ');
  124.       gotoxy(x0+b*i,j+y0);
  125.       if hilf<>Nil then begin
  126.         if hilf=thispage then  write('>')  else  write(' ');
  127.         write(hilf^.pg,'/',hilf^.sp);
  128.         hilf := hilf^.next;
  129.       end;
  130.     end;
  131. end;
  132.  
  133. PROCEDURE mark_list{(reallydraw: Boolean)};
  134. { Gibt die Position des Seiten-Markers <thispage> am Bildschirm aus, für }
  135. { <reallydraw>=FALSE wird die Markierung dagegen aufgehoben. }
  136. CONST x0=10; y0=3+maxactive;
  137.       h=qlen; b=9;
  138. VAR nr: Integer;
  139.     hilf: p_onepage;
  140. BEGIN
  141.   { Herausfinden, die wievielte Seite in der Liste <thispage> ist: }
  142.   hilf := root; nr := 0;
  143.   WHILE (hilf<>Nil) AND (hilf<>thispage) DO BEGIN
  144.     hilf := hilf^.next; Inc(nr);
  145.   END;
  146.   WHILE nr<listoffset DO BEGIN
  147.     listoffset := listoffset-qlen; redraw_list;  END;
  148.   WHILE nr-listoffset>=3*qlen DO BEGIN
  149.     listoffset := listoffset+qlen; redraw_list;  END;
  150.   nr := nr-listoffset;
  151.   GotoXY(x0+b*(nr DIV h),y0+1+nr MOD qlen); Write(#155'37m');
  152.   IF reallydraw THEN  Write('>') ELSE Write(' ');
  153. END;
  154.  
  155. PROCEDURE fileinfo;
  156. CONST x0=1; y0=26;
  157. BEGIN
  158.   GotoXY(x0,y0);
  159.   Write(#155'37mDatei (');
  160.   IF protokoll THEN
  161.     Write('UT-Protokoll): ')
  162.   ELSE IF AsciiRawIff=3 THEN
  163.     Write('IFF-Bild): ')
  164.   ELSE BEGIN
  165.     IF AsciiRawIff=2 THEN  Write('VT, ')
  166.       ELSE  Write('ASCII, ');
  167.     IF overwrite THEN  Write('}berschr.): ')
  168.       ELSE  Write('anf}gend): ');
  169.   END;
  170.   Write(#155'36m'+outputname); ClrEoL;
  171. END;
  172.  
  173. PROCEDURE test{(active: Boolean)};
  174. { Decodertest, sollte aus einer Schleife heraus aufgerufen werden. }
  175. { für active=false wird ein leeres Testfeld erzeugt. }
  176. const x0=26; y0=1;
  177. var stat: byte;
  178.     zeit: str80;
  179.     ch: char;
  180.     tag,min,tic: Long;
  181. procedure zweistellig(x: integer);  begin  write(x div 10, x mod 10);  end;
  182. begin
  183.   gotoxy(x0,y0);
  184.   write(#155'37mStatus:');
  185.   if not active then begin
  186.     for stat := 1 to 4 do begin
  187.       gotoxy(x0,y0+stat); write('             ');  { 13 Spaces }
  188.     end;
  189.     write(#155,'36m');
  190.   end;
  191.   gotoxy(x0,y0+1); write('Bus:');
  192.   gotoxy(x0+5,y0+1); write('AV:');
  193.   gotoxy(x0+5,y0+2); write('VT:');
  194.   gotoxy(x0,y0+3); write(' VT:');
  195.   gotoxy(x0,y0+4); write('Sys:');
  196.   if active then begin
  197.     write(#155'36m');
  198.     stat := VTstat;
  199.     gotoxy(x0,y0+2);
  200.     if i2c_status=0 then begin
  201.       write('OK ');
  202.       gotoxy(x0+9,y0+1)
  203.       if (stat and $01) <> 0 then
  204.         write('ja  ')  else  write('nein');
  205.       gotoxy(x0+9,y0+2);
  206.       if (stat and $02) <> 0 then
  207.         write('ja  ')  else  write('nein');
  208.     end else
  209.       if i2c_status=1 then
  210.         write('NAK')  else  write('tot');
  211.     { Zeit aus dem VT-Seitenspeicher abfragen: }
  212.     gettime(aktspeicher,zeit);
  213.     gotoxy(x0+5,y0+3); write(zeit);
  214.     { zum Vergleich: Amiga-Zeit }
  215.     telltime(tag,min,tic);
  216.     gotoxy(x0+5,y0+4);
  217.     zweistellig(min DIV 60); write(':');
  218.     zweistellig(min MOD 60); write(':');
  219.     zweistellig(tic DIV 50);
  220.   end;
  221. end;
  222.  
  223. PROCEDURE displayhelp;
  224. { äöüß sind für den teletext.font durch {|}~ zu ersetzen! }
  225. var ch: Char;
  226.     l: Long;
  227. begin
  228.   clrscr;
  229.   Write(#155'33m');
  230.   WriteLn('                  VIDEOTEXT-SOFTWARE f}r I2C-Bus am RS232-Port'#155'32m');
  231.   WriteLn('          Programmautor: Wilhelm N|ker, Hertastr. 8, D-44388 Dortmund');
  232.   WriteLn('                 Compiler: KICK-Pascal 2.12 von MAXON Computer');
  233.   WriteLn(#155'36m');
  234.   WriteLn('Seiten k|nnen }ber einfache Seitennumern ('#155'37m572'#155'36m) oder }ber Unterseitennummern');
  235.   WriteLn('('#155'37m642/2'#155'36m) angefordert werden. Die Eingabe l{~t sich mit der <Backspace>-Taste');
  236.   WriteLn('korrigieren und wird mit <Enter> abgeschlossen.');
  237.   WriteLn;
  238.   WriteLn('  Crsr   Seiten durchbl{ttern           +/-   Warteschlange durchgehen');
  239.   WriteLn('  Space  angew{hlte Seite anzeigen      *     Job aus der Schlange l|schen');
  240.   WriteLn('  ?      Geheimschrift aufdecken        u     Untertitelstatus erzwingen');
  241.   WriteLn('  Del    Seite wegwerfen');
  242.   WriteLn('                                        F8    alle Seiten wegwerfen');
  243.   WriteLn('  s      Seite speichern                F9    alle Jobs l|schen');
  244.   WriteLn('  n      Dateinamen {ndern              F10   Seitenvorauswahl einlesen');
  245.   WriteLn('  f      Dateiformat: ASCII/VT/IFF');
  246.   WriteLn('  m      Modus: anh{ngen/}berschr.      t     Test/Uhr ein/aus');
  247.   WriteLn('  p      UT-Protokoll ein/aus           i     Seitenangebot');
  248.   WriteLn('                                        Help  diese Seite');
  249.   WriteLn('  F1/F2/F3  Fersehdarstellung           x     Programmende');
  250.   WriteLn('         voll/transparent/aus');
  251.   WriteLn(#155'33m');
  252.   WriteLn('                                    FREEWARE'#155'32m');
  253.   WriteLn('VideoText darf beliebig kopiert und weitergegeben werden. Meinungen, Kritik und');
  254.   WriteLn('    Anregungen (an obige Adresse) sind stets willkommen. Schreiben Sie mir!');
  255.   repeat
  256.     l := Wait(-1);
  257.     stop := stop OR abbruch_test;
  258.     ch := readkey;
  259.   until (ch<>chr(0)) or stop;
  260. end;
  261.  
  262. PROCEDURE scanpages;
  263. var i,u,t,h,delta,pg_cnt,sp_cnt: integer;
  264.     max: array[100..899] of integer;
  265.     ch: char;
  266.     dummy: p_onepage;
  267. begin
  268.   New(dummy);
  269.   anfordern(0, 100, 0, '***');
  270.   for i := 100 to 899 do
  271.     max[i] := 0;
  272.   ClrScr;
  273.   gotoxy(18,1); write(#155'37mS E I T E N A N G E B O T'#155'36m');
  274.   write('  -  Abbruch mit ESC');
  275.   for i := 10 to 49 do begin
  276.     gotoxy(17*(i div 10)-10,3+i mod 10);
  277.     write(intstr(10*i)+': ----------');
  278.     gotoxy(17*(i div 10)-10,14+i mod 10);
  279.     write(intstr(400+10*i)+': ----------');
  280.   end;
  281.   pg_cnt := 0;
  282.   sp_cnt := 0;
  283.   repeat
  284.     getpage(0,dummy,false);
  285.     u := dummy^.pg mod 10;
  286.     t := (dummy^.pg div 10) mod 10;
  287.     h := dummy^.pg div 100;
  288.     gotoxy(12+17*((h-1) mod 4)+u, 3+t+11*((h-1) div 4));
  289.     if max[dummy^.pg]=0 then Inc(pg_cnt);
  290.     delta := dummy^.sp-max[dummy^.pg];
  291.     if delta>=0 then
  292.       if dummy^.sp=0 then begin
  293.         max[dummy^.pg] := 1;
  294.         write(chr(127));
  295.         Inc(sp_cnt);
  296.       end else begin
  297.         max[dummy^.pg] := dummy^.sp;
  298.         if dummy^.sp<10 then write(chr(dummy^.sp+ord('0'))) else write('+');
  299.         if dummy^.sp<100 THEN sp_cnt := sp_cnt + delta;
  300.       end;
  301.     gotoxy(25,25);
  302.     write(pg_cnt:3,' Seitennummern, ',sp_cnt:4,' Seiten');
  303.     ch := readkey;
  304.     stop := stop OR abbruch_test;
  305.   until (ch = chr(27)) OR stop;
  306.   with activejobs[0] do
  307.     if pg>0 then  anfordern(0, pg, sp, '!!!')  else  sperren(0);
  308. end;
  309.  
  310. PROCEDURE writepage{(seite: p_onepage, verdeckt: Boolean)};
  311. { Seite am Bildschirm ausgeben }
  312. var zeile,i,j,j0: Integer;
  313.     out: bigstring;
  314.     s: str80;
  315.     dblheight,special: Boolean;
  316. begin
  317.   cursoron;
  318.   dblheight := False;
  319.   seite^.chars[0] := 2;  { Seitennummer zunächst grün }
  320.   for i := 0 to 24 do begin
  321.     zeile := i MOD 24;
  322.     IF i=24 THEN BEGIN
  323.       seite^.chars[0] := 7;  { Seitennummer weiß -> Seite komplett }
  324.       dblheight := False;
  325.     END;
  326.     IF dblheight THEN
  327.       dblheight := False
  328.     ELSE BEGIN
  329.       IF seite<>Nil THEN
  330.         decode_line(seite, zeile, verdeckt, out, dblheight)
  331.       ELSE
  332.         out := blank40;
  333.       GotoXY(40,zeile+1); Write(out,#155'0;37;40m');
  334.       IF dblheight THEN BEGIN   { Handhabung doppelthoher Zeilen }
  335.         special := False;
  336.         FOR j := 1 TO Length(out) DO BEGIN   { alles außer den ANSI-Codes }
  337.           { entfernen -> erzeugt Kopie der Hintergrundfarben der Zeile }
  338.           IF out[j] = #155 THEN special := True;
  339.           IF NOT special THEN out[j] := ' ';
  340.           IF out[j] = 'm' THEN special := False;
  341.         END;
  342.         GotoXY(40,zeile+2); write(out,#155'0;37;40m');
  343.         special := False;
  344.         FOR j := 0 TO 39 DO   { doppelthohe Abschnitte suchen }
  345.           CASE seite^.chars[40*zeile+j] OF
  346.             13: BEGIN j0 := j; special := True; END;
  347.             12: IF special THEN BEGIN
  348.                 stretch_line(zeile+1,40+j0,40+j); special := False;
  349.               END;
  350.             OTHERWISE;
  351.           END;
  352.         IF special THEN
  353.           stretch_line(zeile+1,40+j0,79);
  354.       END;
  355.     END;
  356.     lastkey := readkey; { Taste: Abbruch und Rückmeldung ans HP }
  357.     stop := stop OR abbruch_test;
  358.     IF (lastkey<>chr(0)) OR stop THEN BEGIN
  359.       cursoroff;
  360.       exit;
  361.     END;
  362.   END;
  363.   cursoroff;
  364. END;
  365.  
  366. PROCEDURE redraw_all;
  367. { kompletter Neuaufbau des Bildschirms, inklusive clrscr }
  368. begin
  369.   ClrScr;
  370.   writepage(thispage,true); test(false);
  371.   redraw_queue(-1); redraw_list; fileinfo;
  372. end;
  373.  
  374. BEGIN { Initialisierungsteil }
  375.   listoffset := 0;
  376. END.
  377.